unit fonts;

{*
Bitmapped Font. All characters are in Single texture like this:

  +------------------+
  | _ !"#$&'()*+,-./ |       Normal Font
  | 0123456789:;<=>? |
  | @ABCDEFGHIJKLMNO |
  | PQRSTUVWXYZ[\]^_ |
  | `abcdefghijklmno |
  | pqrstuvwxyz(|)~  |
  | ???????????????? | 2x16 characters above ascii #127
  | ???????????????? | _________________________
  | _ !"#$&`()*+,-./ |
  | 0123456789:;<=>? |        Bold Font
  | @ABCDEFGHIJKLMNO |
  | PQRSTUVWXYZ[\]^_ |
  | `abcdefghijklmno |
  | pqrstuvwxyz(|)~  |
  | ???????????????? |
  | ???????????????? |
  +------------------+

Notice there is a space for 32 character above character #127, which
is used in ascii for regional characters, e.g. in Latin-1. However,
we will not use regional characters cause we cannot handle all languages
in 1 bitmapped Font anyway. If you need regional characters, Create
new Font texture and use it as a standalone Font.
}

interface

uses Classes, gl, glu, glut, textures, opengls;

type
  TFont = class
  private
    FTexture: TTexture;
    FBase: gluint;
  FColor: array[0..2] of glFloat;
    procedure BuildFont;
  public
    Bold: boolean;
    constructor Create(AFileName: string);
    destructor Destroy; override;
    procedure OutTextXY(AX, AY: integer; AText: string);
    procedure OutText(AText: string);
  procedure SetColor(ARed, AGreen, ABlue : real);
  end;
  
var
  Font : TFont;

implementation

constructor TFont.Create(AFileName: string);
begin
  FTexture := TTexture.Create;
  FTexture.Load(AFileName);
  SetColor(1,1,1);
  BuildFont;
end;

destructor TFont.Destroy;
begin
  FTexture.Free;
  glDeleteLists(FBase, 256);
  inherited;
end;

procedure TFont.BuildFont;
var
  cx, cy: GLfloat;
  loop: gluint;
begin
  FBase := glGenLists(256);
  glBindTexture(GL_TEXTURE_2D, FTexture.Id);
  for loop := 255 downto 0 do
  begin
    cx := (loop mod 16) / 16 + 0.004;
    cy := -(loop div 16) / 16 + 0.004;
    glNewList(FBase + loop, GL_COMPILE);
    glBegin(GL_QUADS);
    glTexCoord2f(cx, 1 - cy);
    glVertex2i(0, 0);
    glTexCoord2f(cx + 1 / 16, 1 - cy);
    glVertex2i(16, 0);
    glTexCoord2f(cx + 1 / 16, 1 - cy - 1 / 16);
    glVertex2i(16, 16);
    glTexCoord2f(cx, 1 - cy - 1 / 16);
    glVertex2i(0, 16);
    glEnd;
    glTranslated(10, 0, 0);
    glEndList;
  end;
end;

procedure TFont.OutTextXY(AX, AY: integer; AText: string);
var
  b: gluint;
begin
  if Atext = '' then
    exit;
  b := 0;
  if Bold then
    b := 1;
  glDisable(GL_LIGHTING);
  glColor3f(FColor[0],FColor[1],FColor[2]);
  glDisable(GL_TEXTURE_GEN_S);
  glDisable(GL_TEXTURE_GEN_T);
  glTexEnvf(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE);
  glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
  glEnable(GL_BLEND);
  glEnable(GL_TEXTURE_2D);
  glBindTexture(GL_TEXTURE_2D, FTexture.Id);
  glDisable(GL_DEPTH_TEST);
  glMatrixMode(GL_PROJECTION);
  glPushMatrix;
  glLoadIdentity;
  glOrtho(0, ScreenWidth, 0, ScreenHeight, -1, 1);
  glMatrixMode(GL_MODELVIEW);
  glPushMatrix;
  glLoadIdentity;
  glTranslated(AX, ScreenHeight - AY - 16, 0);
  glListBase(FBase - 32 + 16 + (128 * b));
  glCallLists(Length(AText), GL_BYTE, PChar(AText));
  glMatrixMode(GL_PROJECTION);
  glPopMatrix;
  glMatrixMode(GL_MODELVIEW);
  glPopMatrix;
  glEnable(GL_DEPTH_TEST);
  glEnable(GL_LIGHTING);
end;

procedure TFont.OutText(AText: string);
var
  b: gluint;
begin
  if Atext = '' then
    exit;
  b := 0;
  if Bold then
    b := 1;
  glTexEnvf(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE);
  glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
  glEnable(GL_BLEND);
  glEnable(GL_TEXTURE_2D);
  glBindTexture(GL_TEXTURE_2D, FTexture.Id);
  glListBase(FBase - 32 + 16 + (128 * b));
  glCallLists(Length(AText), GL_BYTE, PChar(AText));
end;

procedure TFont.SetColor(ARed, AGreen, ABlue : real);
begin
  FColor[0] := ARed;
  FColor[1] := AGreen;
  FColor[2] := ABlue;
end;

end.
